Mastering Microsoft Visual Basic 5/Mastering Microsoft Visual Basic 5.ISO/demo code/ch11/winsock1/frmchat1.frm

Visual Basic Form | 1997-02-06 | 13.2 KB | 437 lines

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmChat1
   Caption         =   "Winsock Chatter"
   ClientHeight    =   6075
   ClientLeft      =   1710
   ClientTop       =   1485
   ClientWidth     =   6870
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   6075
   ScaleWidth      =   6870
   Begin VB.Timer Timer1
      Interval        =   1000
      Left            =   1920
      Top             =   7140
   End
   Begin MSWinsockLib.Winsock socServer
      Left            =   300
      Top             =   7140
      _ExtentX        =   741
      _ExtentY        =   741
   End
   Begin MSWinsockLib.Winsock socClient
      Left            =   1080
      Top             =   7140
      _ExtentX        =   741
      _ExtentY        =   741
   End
   Begin VB.Frame ssfReceive
      Caption         =   "&Server Info:"
      Height          =   2955
      Left            =   60
      TabIndex        =   0
      Top             =   60
      Width           =   6735
      Begin VB.TextBox txtRemotePort
         Height          =   315
         Left            =   4500
         TabIndex        =   6
         Top             =   1200
         Visible         =   0   'False
         Width           =   675
      End
      Begin VB.ComboBox cboServerProtocol
         Height          =   315
         ItemData        =   "frmChat1.frx":0000
         Left            =   4500
         List            =   "frmChat1.frx":0002
         TabIndex        =   4
         Top             =   780
         Width           =   2055
      End
      Begin VB.TextBox txtReceivedData
         Height          =   675
         Left            =   1140
         MultiLine       =   -1  'True
         TabIndex        =   16
         TabStop         =   0   'False
         Top             =   1680
         Width           =   5415
      End
      Begin VB.CommandButton cmdCloseServerConnection
         Caption         =   "&Close"
         Height          =   315
         Left            =   2280
         TabIndex        =   8
         Top             =   2460
         Width           =   915
      End
      Begin VB.CommandButton cmdListen
         Caption         =   "&Listen"
         Height          =   315
         Left            =   1140
         TabIndex        =   7
         Top             =   2460
         Width           =   915
      End
      Begin VB.TextBox txtServerState
         Enabled         =   0   'False
         Height          =   315
         Left            =   1140
         TabIndex        =   14
         TabStop         =   0   'False
         Top             =   1200
         Width           =   1995
      End
      Begin VB.TextBox txtLocalIPAddress
         Enabled         =   0   'False
         Height          =   315
         Left            =   1140
         TabIndex        =   12
         TabStop         =   0   'False
         Top             =   780
         Width           =   1995
      End
      Begin VB.TextBox txtLocalPort
         Height          =   315
         Left            =   4500
         TabIndex        =   2
         Top             =   360
         Width           =   675
      End
      Begin VB.TextBox txtLocalHost
         Enabled         =   0   'False
         Height          =   315
         Left            =   1140
         TabIndex        =   10
         TabStop         =   0   'False
         Top             =   360
         Width           =   1995
      End
      Begin VB.Label lblRemotePort
         Caption         =   "Remote Port:"
         Height          =   195
         Left            =   3360
         TabIndex        =   5
         Top             =   1260
         Visible         =   0   'False
         Width           =   1095
      End
      Begin VB.Label lblServerProtocol
         Caption         =   "&Protocol:"
         Height          =   255
         Left            =   3360
         TabIndex        =   3
         Top             =   840
         Width           =   915
      End
      Begin VB.Label lblReceivedData
         Caption         =   "Rec'd Data:"
         Height          =   255
         Left            =   180
         TabIndex        =   15
         Top             =   1740
         Width           =   915
      End
      Begin VB.Label lblServerState
         Caption         =   "State:"
         Height          =   255
         Left            =   180
         TabIndex        =   13
         Top             =   1200
         Width           =   915
      End
      Begin VB.Label lblLocalIPAddress
         Caption         =   "Local IP:"
         Height          =   255
         Left            =   180
         TabIndex        =   11
         Top             =   780
         Width           =   915
      End
      Begin VB.Label lblLocalPort
         Caption         =   "Local Port:"
         Height          =   195
         Left            =   3360
         TabIndex        =   1
         Top             =   420
         Width           =   855
      End
      Begin VB.Label lblLocalHost
         Caption         =   "&Local Host:"
         Height          =   255
         Left            =   180
         TabIndex        =   9
         Top             =   420
         Width           =   915
      End
   End
   Begin VB.Frame ssfRemote
      Caption         =   "Client Info:"
      Height          =   2895
      Left            =   60
      TabIndex        =   17
      Top             =   3120
      Width           =   6735
      Begin VB.TextBox txtClientLocalPort
         Height          =   315
         Left            =   4560
         TabIndex        =   25
         Top             =   1200
         Visible         =   0   'False
         Width           =   675
      End
      Begin VB.ComboBox cboClientProtocol
         Height          =   315
         ItemData        =   "frmChat1.frx":0004
         Left            =   4560
         List            =   "frmChat1.frx":0006
         TabIndex        =   23
         Top             =   780
         Width           =   2055
      End
      Begin VB.TextBox txtHostIPAddress
         Enabled         =   0   'False
         Height          =   315
         Left            =   1080
         TabIndex        =   32
         TabStop         =   0   'False
         Top             =   780
         Width           =   1995
      End
      Begin VB.CommandButton cmdCloseClientConnection
         Caption         =   "C&lose"
         Height          =   315
         Left            =   3660
         TabIndex        =   30
         Top             =   2460
         Width           =   1095
      End
      Begin VB.CommandButton cmdSend
         Caption         =   "&Send"
         Height          =   315
         Left            =   2340
         TabIndex        =   29
         Top             =   2460
         Width           =   1095
      End
      Begin VB.CommandButton cmdConnect
         Caption         =   "&Connect"
         Height          =   315
         Left            =   1080
         TabIndex        =   26
         Top             =   2460
         Width           =   1095
      End
      Begin VB.TextBox txtClientData
         Height          =   675
         Left            =   1080
         MultiLine       =   -1  'True
         TabIndex        =   28
         Top             =   1680
         Width           =   5475
      End
      Begin VB.TextBox txtClientState
         Enabled         =   0   'False
         Height          =   315
         Left            =   1080
         TabIndex        =   34
         TabStop         =   0   'False
         Top             =   1200
         Width           =   1995
      End
      Begin VB.TextBox txtHostPort
         Height          =   315
         Left            =   4560
         TabIndex        =   21
         Top             =   360
         Width           =   675
      End
      Begin VB.TextBox txtHost
         Height          =   315
         Left            =   1080
         TabIndex        =   19
         Top             =   360
         Width           =   1995
      End
      Begin VB.Label lblClientLocalPort
         Caption         =   "Local Port:"
         Height          =   195
         Left            =   3360
         TabIndex        =   24
         Top             =   1260
         Visible         =   0   'False
         Width           =   975
      End
      Begin VB.Label lblClientProtocol
         Caption         =   "&Protocol:"
         Height          =   255
         Left            =   3360
         TabIndex        =   22
         Top             =   840
         Width           =   915
      End
      Begin VB.Label lblRemoteIP
         Caption         =   "&Host IP:"
         Height          =   255
         Left            =   120
         TabIndex        =   31
         Top             =   840
         Width           =   915
      End
      Begin VB.Label lblClientData
         Caption         =   "Send Data:"
         Height          =   255
         Left            =   120
         TabIndex        =   27
         Top             =   1740
         Width           =   915
      End
      Begin VB.Label lblClientState
         Caption         =   "State:"
         Height          =   255
         Left            =   120
         TabIndex        =   33
         Top             =   1200
         Width           =   915
      End
      Begin VB.Label lblHostPort
         Caption         =   "Host Port:"
         Height          =   195
         Left            =   3360
         TabIndex        =   20
         Top             =   420
         Width           =   975
      End
      Begin VB.Label lblHost
         Caption         =   "&Host"
         Height          =   255
         Left            =   120
         TabIndex        =   18
         Top             =   420
         Width           =   915
      End
   End
Attribute VB_Name = "frmChat1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Form_Load()
  On Error GoTo Err_Handler
  InitializeConnectionInfo
  InitializeServerInfo
  SetProtocolCombobox cboClientProtocol
  Exit Sub
Err_Handler:
  MsgBox Err.Description
End Sub
Private Sub cboClientProtocol_Click()
  Dim bTCP As Boolean
  bTCP = (cboClientProtocol.ListIndex = 0)
  lblClientLocalPort.Visible = Not bTCP
  txtClientLocalPort.Visible = Not bTCP
End Sub
Private Sub cboServerProtocol_Click()
  Dim bTCP As Boolean
  bTCP = (cboServerProtocol.ListIndex = 0)
  lblRemotePort.Visible = Not bTCP
  txtRemotePort.Visible = Not bTCP
End Sub
Private Sub cmdListen_Click()
  On Error GoTo Err_Handler
  With socServer
    .Protocol = _
      cboServerProtocol.ItemData(cboServerProtocol.ListIndex)
    If .Protocol = sckTCPProtocol Then
      .LocalPort = txtLocalPort
      .Listen
    Else
      .RemotePort = txtRemotePort
      .Bind txtLocalPort
    End If
  End With
  Exit Sub
Err_Handler:
  MsgBox Err.Description
End Sub
Private Sub cmdConnect_Click()
  On Error GoTo Err_Handler
  With socClient
    .RemoteHost = txtHost
    .RemotePort = txtHostPort
    .Protocol = _
      cboClientProtocol.ItemData(cboClientProtocol.ListIndex)
    If .Protocol = sckTCPProtocol Then
      .Connect
      txtHostIPAddress = socClient.RemoteHostIP
    Else
      .Bind txtClientLocalPort
    End If
  End With
  Exit Sub
Err_Handler:
  MsgBox Err.Description
End Sub
Private Sub socServer_ConnectionRequest(ByVal requestID As Long)
  On Error GoTo Err_Handler
  With socServer
    If .State <> sckClosed Then
      .Close
    End If
    .Accept requestID
  End With
  Debug.Print "Connection Accepted with RequestID = " & Str$(requestID)
  Exit Sub
Err_Handler:
  MsgBox Err.Description
End Sub
Private Sub cmdSend_Click()
  On Error GoTo Err_Handler
  socClient.SendData txtClientData
  Exit Sub
Err_Handler:
  MsgBox Err.Description
End Sub
Private Sub socServer_DataArrival(ByVal bytesTotal As Long)
  Dim sData As String
  Debug.Print Str$(bytesTotal) & " of data arrived."
  socServer.GetData sData
  txtReceivedData = sData
End Sub
Private Sub cmdCloseClientConnection_Click()
  On Error GoTo Err_Handler
  socClient.Close
  Exit Sub
Err_Handler:
  MsgBox Err.Description
End Sub
Private Sub cmdCloseServerConnection_Click()
  On Error GoTo Err_Handler
  socServer.Close
  Exit Sub
Err_Handler:
  MsgBox Err.Description
End Sub
Private Sub Timer1_Timer()
  ' Update Local Connection
  GetConnectionState
End Sub
Private Sub InitializeServerInfo()
  On Error GoTo Err_Handler
  txtLocalHost = socServer.LocalHostName
  txtLocalIPAddress = socServer.LocalIP
  SetProtocolCombobox cboServerProtocol
  GetConnectionState
  Exit Sub
Err_Handler:
  MsgBox Err.Description
End Sub
Private Sub GetConnectionState()
  txtServerState = strState(socServer.State)
  txtClientState = strState(socClient.State)
End Sub